home *** CD-ROM | disk | FTP | other *** search
/ LOGIC Apps / Logic-APPLE_II_APPS.iso / pc / LOGIC Apple II 5.25" Library - DOS Part 3 / DOS065.dsk / FILE CABINET I.bas < prev    next >
BASIC Source File  |  2012-02-16  |  10KB  |  318 lines
  1. 1 D$ = "<CTRL-D>": REM CTRL D
  2. 2  PRINT D$"NOMON I,C,O"
  3. 3  PRINT D$"MAXFILES1"
  4. 5  TEXT : HOME 
  5. 7  GOSUB 30500
  6. 10  CLEAR 
  7. 11  DIM R$(21),AC(21),T(21),TF(21),K(21)
  8. 15 D$ = "<CTRL-D>": REM CTRL D
  9. 16 R$(0) = "REC#"
  10. 20 DB$ = "":F$ = "BASENAME": ONERR  GOTO 13240
  11. 25  GOSUB 17000
  12. 30  GOTO 13000
  13. 40 DB$ = BN$:F$ = "HEADER": ONERR  GOTO 4000
  14. 42  GOSUB 17000
  15. 45 NH = NR:NR = 0:MEM =  FRE(0)
  16. 46 B =  INT(MEM/(13 *NH))
  17. 47  DIM N$(B,NH)
  18. 50 F$ = "INDEX": ONERR  GOTO 25000
  19. 55  GOSUB 17000
  20. 60  GOTO 25000
  21. 100  REM *** SORT ***
  22. 110 SF = 0
  23. 120  FOR J = 1 TO NR -1
  24. 125  ON L GOTO 130,135
  25. 130  IF N$(J +1,S) <N$(J,S)  THEN  GOSUB 170
  26. 132  GOTO 140
  27. 135  IF  VAL(N$(J +1,S)) < VAL(N$(J,S))  THEN  GOSUB 170
  28. 140  NEXT J
  29. 145  PRINT "SORTING ";
  30. 150  ON SF GOTO 110
  31. 154  PRINT 
  32. 155  PRINT : PRINT "WANT TO SAVE THE SORTED FILE TO DISK--": INPUT "Y/N) ?";L$: IF L$ = "Y"  THEN  GOSUB 18000
  33. 160  GOTO 25000
  34. 170  FOR I = 1 TO NH
  35. 180 Z$ = N$(J,I):N$(J,I) = N$(J +1,I):N$(J +1,I) = Z$
  36. 190  NEXT I:SF = 1
  37. 200  RETURN 
  38. 500  HOME : PRINT "SELECT FROM:": PRINT 
  39. 510  FOR I = 1 TO NH: PRINT I" "R$(I): NEXT I: PRINT 
  40. 520  INPUT "ENTER # OF FIELD FOR SORT ";S$:S =  VAL(S$): IF S <1  OR S >NH  THEN 520
  41. 530  PRINT : PRINT "DO YOU WANT TO SORT:": PRINT 
  42. 540  PRINT "1 ALPHABETICALLY"
  43. 550  PRINT "2 NUMERICALLY"
  44. 555  PRINT 
  45. 560  INPUT "WHICH ";L$:L =  VAL(L$)
  46. 570  GOTO 110
  47. 4000  & : REM *** CREATE HEADERFILE ***
  48. 4010 NR = 1
  49. 4020  HOME : PRINT "ENTER 'RTN' TO EXIT TO MENU"
  50. 4025  PRINT 
  51. 4030  PRINT "ENTER HEADER NUMBER "NR" ";: INPUT "";R$(NR)
  52. 4040  IF R$(NR) = ""  OR NR >20  THEN 4065
  53. 4050 NR = NR +1
  54. 4060  GOTO 4030
  55. 4065 NR = NR -1
  56. 4070  GOSUB 18000: GOTO 45
  57. 6000  REM ***ENTER RECORDS***
  58. 6010  HOME 
  59. 6030  PRINT "THERE ARE "NR" RECORDS"
  60. 6031  PRINT "IN THE "BN$" FILE"
  61. 6033 NR = NR +1
  62. 6035  PRINT "YOU ARE ENTERING RECORD # "NR
  63. 6040  PRINT 
  64. 6050  FOR I = 1 TO NH
  65. 6060  PRINT R$(I)":";: INPUT "";N$(NR,I)
  66. 6070  NEXT I
  67. 6090  PRINT 
  68. 6100  INPUT "MORE (Y/N) ";L$
  69. 6110  IF L$ = "Y"  THEN 6030
  70. 6140  GOSUB 18000
  71. 6150  GOTO 25000
  72. 7000  REM ***SEARCH/CHANGE***
  73. 7005 L = 0
  74. 7010  HOME 
  75. 7020  PRINT "YOU MAY SEARCH BY ANY OF THE FOLLOWING:"
  76. 7030  PRINT 
  77. 7040  FOR I = 0 TO NH
  78. 7050  PRINT I" "R$(I)
  79. 7060  NEXT I
  80. 7062  PRINT : PRINT "OR YOU MAY": PRINT 
  81. 7065  PRINT I" MAKE CHANGES"
  82. 7070  PRINT 
  83. 7080  INPUT "WHICH ";S$:S =  VAL(S$)
  84. 7085  IF S <0  OR S >NH +1  THEN 7080
  85. 7087  IF S = NH +1  THEN 9000
  86. 7090  HOME 
  87. 7100  PRINT "PLEASE ENTER THE "R$(S): PRINT "YOU WANT TO FIND.......<CTRL-J>": INPUT "";Q$
  88. 7110  HOME 
  89. 7120  FOR J = 1 TO NR
  90. 7125 N$(J,0) =  STR$(J)
  91. 7130  IF  LEFT$(N$(J,S), LEN(Q$)) = Q$  THEN  GOSUB 10000
  92. 7135  IF L +NH >20  THEN  GOSUB 7180
  93. 7140  NEXT J
  94. 7150  PRINT "THAT'S ALL OF THEM. ";
  95. 7160  PRINT "NOW YOU MAY:"
  96. 7170  PRINT "1 DO MORE SEARCHES"
  97. 7171  PRINT "2 MAKE CHANGES"
  98. 7172  PRINT "3 RETURN TO THE MAIN MENU"
  99. 7173  INPUT "<CTRL-J>WHICH ";S$:S =  VAL(S$)
  100. 7174  IF S <1  OR S >3  THEN 7173
  101. 7175  ON S GOTO 7010,9000,25000
  102. 7180  ON PF GOTO 7190,7190: INPUT "<CTRL-J>HIT RETURN TO CONTINUE...";L$
  103. 7190 L = 0: HOME : RETURN 
  104. 9000  REM ***CHANGE DATA***
  105. 9005  PRINT "<CTRL-J>ENTER THE NUMBER OF THE RECORD"
  106. 9006  INPUT "YOU WANT TO CHANGE ";J$:J =  VAL(J$)
  107. 9007  HOME : GOSUB 10000
  108. 9010  PRINT "<CTRL-J>ENTER THE NUMBER OF THE FIELD YOU WANT": PRINT "TO CHANGE ";
  109. 9020  INPUT "";S$:S =  VAL(S$)
  110. 9022  IF S <1  OR S >NH  THEN 9020
  111. 9025  PRINT 
  112. 9030  PRINT "FROM "R$(S)": "N$(J,S)
  113. 9040  PRINT 
  114. 9050  PRINT "TO "R$(S)": ";: INPUT "";N$(J,S)
  115. 9060  PRINT 
  116. 9070  INPUT "<CTRL-J>MORE CHANGES (Y/N) ";L$
  117. 9080  IF L$ = "Y"  THEN 9000
  118. 9090 DB$ = BN$:F$ = "INDEX": GOSUB 18000: GOTO 25000
  119. 10000  REM ***PRINT A RECORD***
  120. 10003  IF PF >0  THEN  GOSUB 31000
  121. 10005  PRINT "  "R$(0)": ";J
  122. 10010  FOR I = 1 TO NH
  123. 10020  PRINT I" "R$(I)": "N$(J,I)
  124. 10030  NEXT I
  125. 10035  PRINT 
  126. 10036 L = L +NH +2
  127. 10037  IF PF >0  THEN  CALL 768
  128. 10040  RETURN 
  129. 11000  REM ***DELETE RECORDS***
  130. 11010  HOME 
  131. 11020  INPUT "ENTER RECORD NUMBER YOU WANT DELETED ";DR$:DR =  VAL(DR$)
  132. 11025  IF DR <1  OR DR >NR  THEN 11020
  133. 11030  FOR J = DR TO NR -1
  134. 11040  FOR I = 1 TO NH
  135. 11050 N$(J,I) = N$(J +1,I)
  136. 11060  NEXT I
  137. 11070  NEXT J
  138. 11080  PRINT : PRINT "RECORD NUMBER "DR" DELETED!": PRINT 
  139. 11090  INPUT "MORE (Y/N) ";L$
  140. 11100  IF L$ = "Y"  THEN 11020
  141. 11110 NR = NR -1:DB$ = BN$:F$ = "INDEX": GOSUB 18000: GOTO 25000
  142. 13000  REM *** BASENAMEFILE ROUTINES ***
  143. 13110  HOME 
  144. 13120  PRINT "SELECT FROM:"
  145. 13130  PRINT 
  146. 13140  FOR J = 1 TO NR
  147. 13150  PRINT J" "R$(J)
  148. 13160  NEXT J
  149. 13170  PRINT 
  150. 13180  PRINT J" CREATE A NEW DATA BASE"
  151. 13190  PRINT 
  152. 13200  INPUT "WHICH ";S$:S =  VAL(S$)
  153. 13210  IF S <1  OR S >J  THEN 13200
  154. 13220 DB$ = R$(S):BN<CTRL-K><CTRL-D>R$(S)
  155. 13230  IF S < >J  THEN 40
  156. 13235  PRINT 
  157. 13240  & : IF J = 0  THEN J = 1
  158. 13245  INPUT "ENTER NAME OF NEW DATA BASE ";R$(J)
  159. 13250 NR = J: GOSUB 18000
  160. 13260 BN$ = R$(J -1): GOTO 40
  161. 14000  REM ***REPORT***
  162. 14010  HOME 
  163. 14020  FOR I = 0 TO NH +1:AC(I) = 0:T(I) = 0:TF(I) = 0:K(I) = 0: NEXT I
  164. 14025  PRINT "1 CREATE A NEW REPORT": PRINT "2 USE A REPORT FORMAT FROM DISK": PRINT : INPUT "WHICH ";E$:E =  VAL(E$)
  165. 14027  IF E <1  OR E >2  THEN 14025
  166. 14028  ON E GOTO 14030,15000
  167. 14030  PRINT : PRINT "SELECT FROM:": PRINT 
  168. 14040  FOR I = 0 TO NH
  169. 14050  PRINT I" "R$(I)
  170. 14060  NEXT I
  171. 14062  ON E GOTO 14065,14125
  172. 14065  PRINT : INPUT "HOW MANY HEADERS ";RH$:RH =  VAL(RH$): IF RH <1  OR RH >NH +1  THEN 14065
  173. 14067 RF$ = "THIS"
  174. 14070  FOR I = 1 TO RH
  175. 14080  PRINT "ENTER # OF HEADER YOU WANT IN": PRINT "POSITION #"I" ";: INPUT "";K$:K(I) =  VAL(K$)
  176. 14085  IF K(I) <0  OR K(I) >NH  THEN 14080
  177. 14090  PRINT "ENTER TAB FOR "R$(K(I))" ";: INPUT "";T$:T(I) =  VAL(T$)
  178. 14095  IF T(I) <0  OR T(I) >255  THEN 14090
  179. 14100  PRINT "TOTAL ON "R$(K(I))" (Y/N) ";: INPUT L$
  180. 14110  IF L$ = "Y"  THEN TF(I) = 1
  181. 14120  NEXT I
  182. 14125  PRINT : PRINT "@ WILL SELECT ALL RECORDS.": PRINT 
  183. 14130  INPUT "SELECT RECORDS BY WHICH HEADER # ";S$:S =  VAL(S$)
  184. 14135  PRINT : INPUT "'AND' 2ND HEADER (Y/N) ";L$: IF L$ < >"Y"  THEN X$ = "@": GOTO 14150
  185. 14140  PRINT : INPUT "ENTER # OF 'AND' HEADER ";X$:X =  VAL(X$)
  186. 14150  PRINT : PRINT "SELECT RECORDS FOR "R$(S)"= ";: INPUT "";Q$: PRINT 
  187. 14160  IF L$ = "Y"  THEN  PRINT "AND "R$(X)"= ";: INPUT "";X$
  188. 14200  GOSUB 14500
  189. 14210  FOR J = 1 TO NR
  190. 14215 N$(J,0) =  STR$(J)
  191. 14220  IF Q$ = "@"  THEN 14224
  192. 14221  IF  LEFT$(N$(J,S), LEN(Q$)) < >Q$  THEN 14225
  193. 14222  IF X$ = "@"  THEN 14224
  194. 14223  IF  LEFT$(N$(J,X), LEN(X$)) < >X$  THEN 14225
  195. 14224  GOSUB 14300
  196. 14225  IF PF >0  THEN 14230
  197. 14226  IF L >18  THEN  GOSUB 7180: GOSUB 14500
  198. 14230  NEXT J
  199. 14240  ON TF(0) GOSUB 14450
  200. 14242  IF PF >0  THEN  CALL 768
  201. 14243  ON E GOTO 14244,14247
  202. 14244  PRINT : PRINT "DO YOU WANT TO SAVE THE FORMAT": INPUT "FOR THIS REPORT TO DISK (Y/N) ";L$
  203. 14246  IF L$ = "Y"  THEN 16000
  204. 14247  PRINT : PRINT "MORE REPORTS USING THE "RF$" FORMAT": INPUT "(Y/N) ";L$
  205. 14248  IF L$ = "Y"  THEN E = 2: FOR I = 0 TO NH +1:AC(I) = 0: NEXT I: GOTO 14030
  206. 14250  GOTO 25000
  207. 14300  IF PF >0  THEN  GOSUB 31000
  208. 14305  FOR I = 1 TO RH
  209. 14310  POKE 36,T(I): PRINT N$(J,K(I));
  210. 14320  ON TF(I) GOSUB 14400
  211. 14340  NEXT I
  212. 14345 L = L +1
  213. 14350  PRINT : IF PF >0  THEN  CALL 768
  214. 14355  RETURN 
  215. 14400 AC(I) = AC(I) + VAL(N$(J,K(I)))
  216. 14410 TF(0) = 1: RETURN 
  217. 14450  IF PF >0  THEN  GOSUB 31000
  218. 14455  FOR I = 1 TO 39 +((2 >1) *38): PRINT "-";: NEXT I: PRINT 
  219. 14460  FOR I = 1 TO RH
  220. 14470  IF AC(I) = 0  THEN 14490
  221. 14480  POKE 36,T(I): PRINT AC(I);
  222. 14490  NEXT I
  223. 14495  PRINT : IF PF >0  THEN  CALL 768
  224. 14497  RETURN 
  225. 14500  HOME : IF PF >0  THEN  GOSUB 31000
  226. 14510  IF PF >0  THEN  POKE 36,30: PRINT "<CTRL-A>"DB$"<CTRL-B>": GOTO 14515
  227. 14512  HTAB 10: PRINT DB$
  228. 14515  IF X$ = "@"  THEN 14518
  229. 14516  PRINT " AND "R$(X)": "X$: GOTO 14520
  230. 14518  PRINT "<CTRL-J>"
  231. 14520  FOR I = 1 TO RH
  232. 14530  POKE 36,T(I): PRINT R$(K(I));
  233. 14540  NEXT I
  234. 14550  PRINT : PRINT 
  235. 14560 L = 4: RETURN 
  236. 15000  REM ***READ REPORTFORMATFILE***
  237. 15010  PRINT : INPUT "ENTER THE REPORT FORMAT NAME ";RF$
  238. 15020  PRINT D$"OPEN"RF$" REPORTFORMATFILE"
  239. 15030  PRINT D$"READ"RF$" REPORTFORMATFILE"
  240. 15040  INPUT RH: FOR I = 1 TO RH: INPUT K(I): INPUT T(I): INPUT TF(I): NEXT I
  241. 15060  PRINT D$"CLOSE"RF$" REPORTFORMATFILE"
  242. 15070  GOTO 14030
  243. 16000  REM ***SAVE REPORTFORMATFILE***
  244. 16010  PRINT : INPUT "ENTER THE REPORT FORMAT NAME ";RF$
  245. 16020  PRINT D$"OPEN"RF$" REPORTFORMATFILE"
  246. 16030  PRINT D$"WRITE"RF$" REPORTFORMATFILE"
  247. 16040  PRINT RH: FOR I = 1 TO RH: PRINT K(I): PRINT T(I): PRINT TF(I): NEXT I
  248. 16060  PRINT D$"CLOSE"RF$" REPORTFORMATFILE"
  249. 16070  GOTO 14247
  250. 17000  REM *** READ FILES ***
  251. 17005  IF F$ < >"INDEX"  THEN FF = 1
  252. 17010  PRINT D$"OPEN"DB$" "F$"FILE"
  253. 17020  PRINT D$"READ"DB$" "F$"FILE"
  254. 17030  INPUT NR
  255. 17050  FOR J = 1 TO NR
  256. 17055  ON FF GOTO 17090
  257. 17060  FOR I = 1 TO NH
  258. 17070  INPUT N$(J,I)
  259. 17080  NEXT I
  260. 17085  IF FF < >1  THEN 17100
  261. 17090  INPUT R$(J)
  262. 17100  NEXT J
  263. 17110  PRINT D$"CLOSE"DB$" "F$"FILE"
  264. 17120 FF = 0
  265. 17130  RETURN 
  266. 18000  REM *** SAVE FILES ***
  267. 18005  IF F$ < >"INDEX"  THEN FF = 1
  268. 18010  PRINT D$"OPEN"DB$" "F$"FILE"
  269. 18020  PRINT D$"WRITE"DB$" "F$"FILE"
  270. 18030  PRINT NR
  271. 18050  FOR J = 1 TO NR
  272. 18055  ON FF GOTO 18090
  273. 18060  FOR I = 1 TO NH
  274. 18070  PRINT N$(J,I)
  275. 18080  NEXT I
  276. 18085  IF FF < >1  THEN 18100
  277. 18090  PRINT R$(J)
  278. 18100  NEXT J
  279. 18110  PRINT D$"CLOSE"DB$" "F$"FILE"
  280. 18120 FF = 0
  281. 18130  RETURN 
  282. 25000  REM   *** MAIN MENU *** 
  283. 25010  HOME : ONERR  GOTO 30000
  284. 25020  PRINT "******* DATA BASE MANAGEMENT I *******"
  285. 25022  PRINT : PRINT "          APPLE COMPUTER INC"
  286. 25025  PRINT 
  287. 25030  PRINT "CURRENT DATA BASE: "BN$: PRINT 
  288. 25032  PRINT "CURRENTLY CONTAINS: "NR" RECORDS": PRINT : PRINT "ROOM FOR "B -NR" MORE RECORDS"
  289. 25033  PRINT 
  290. 25035  IF PF > = 1  THEN  PRINT "THE PRINTER IS ";: FLASH : PRINT "ON": NORMAL : GOTO 25037
  291. 25036  PRINT "THE PRINTER IS OFF"
  292. 25037  PRINT 
  293. 25040  PRINT "1 SELECT DATA BASE"
  294. 25050  PRINT "2 SEARCH AND/OR CHANGE DATA"
  295. 25060  PRINT "3 ENTER RECORDS"
  296. 25070  PRINT "4 DELETE RECORDS"
  297. 25075  PRINT "5 REPORT"
  298. 25080  PRINT "6 SORT"
  299. 25085  PRINT "7 TURN ON PRINTER"
  300. 25087  PRINT "8 TURN OFF PRINTER"
  301. 25088  PRINT "9 QUIT"
  302. 25090  PRINT 
  303. 25100  INPUT "WHICH ";S$:S =  VAL(S$)
  304. 25110  IF S <1  OR S >9  THEN 25000
  305. 25120  ON S GOTO 10,7000,6000,11000,14000,500,25200,25300,30000
  306. 25200  HOME 
  307. 25210  PRINT D$"BLOAD DRIVER"
  308. 25220 PF = 2
  309. 25260  GOTO 25000
  310. 25300 PF = 0: GOTO 25000
  311. 30000  END 
  312. 30500  REM ***ROUTINE TO CORRECTONERR ROUTINE IN APPLESOFT II-&: MUST PRECEDE EACH STATEMENT AT ONERR GOTO LINE #***
  313. 30510  FOR I = 1013 TO 1022: READ PP: POKE I,PP: NEXT I
  314. 30515 I = 0
  315. 30520  RETURN 
  316. 30530  DATA 104,168,104,166,223,154,72,152,72,96
  317. 31000  CALL 875
  318. 31010  RETURN